home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / Toolbox Classes / pictures < prev    next >
Encoding:
Text File  |  1995-11-21  |  1.7 KB  |  60 lines  |  [TEXT/YERK]
  1. \ 2.1.87    rfl version
  2. \ 4.28.88    rfl moveto needs work
  3. \ 8.31.88    rfl added theClip to this source
  4. \ 8.14.90    rfl moveto fixed
  5. \ 4.11.92    rfl    added putResId: as alias for init:
  6. \ 5.13.93    rfl protected getnew:
  7. \ 11/21/95    rfl    clear pichndl after kill
  8.  
  9. rect theClip    \ global clip rectangle
  10. -1000 dup 1000 dup put: theClip
  11.  
  12. : +pair { x1 y1 x2 y2 -- x1+y1 x2+y2 } x1 x2 + y1 y2 + ;
  13.  
  14. \ Interface object for QD picture support
  15. :CLASS Picture  <Super Object
  16.  
  17.     Handle    picHndl
  18.     Int        resID        \ resource ID if it is a resource
  19.     Rect    DestRect    \ destination rectangle for drawing
  20.  
  21.     \ ( l t r b -- )  Open a new pict with given frame
  22.     :M  OPEN:  Put: destrect  0 abs: destrect call OpenPicture
  23.         Put: picHndl  ;M
  24.  
  25.     \ ( -- )  terminate this picture definition
  26.     :M  CLOSE:  call ClosePicture   ;M
  27.  
  28.     \ ( resID -- )
  29.     :M INIT:  put:  resID  ;M
  30.  
  31.     :M PUTRESID: put: resID ;M
  32.  
  33.     \ load the picture from a resource file
  34.     :M  GETNEW:  0 int: resID  call GetPicture dup 0= classerr" 170 put: picHndl
  35.         ptr: picHndl  2+ get: rect  put: destRect   ;M
  36.  
  37.     \ ( w h -- )  Set size in pixels of dest rect
  38.     :M  SIZE:   getTop:  destRect  +Pair  putBot: destRect ;M
  39.  
  40.     \ ( x y -- )  Move dest rect to given location
  41.     :M  GOTO:  { x y -- }   Size: destRect  x y putTop: DestRect
  42.         Size: self  ;M
  43.  
  44.     \ ( -- )  Draw the picture in destRect
  45.     :M  DRAW:  get: picHndl abs: destRect
  46.         call DrawPicture   ;M
  47.  
  48.     \ ( x y resID -- )  Combines the actions of init:, getNew:, goto: & draw:
  49.     :M  DISP:  putResID: self  getNew: self  goto: self  draw: self  ;M
  50.  
  51.     \ goto to location and draw self
  52.     :M  MOVETO: ( x y -- ) goto: self draw: self ;M
  53.  
  54.     \ ( -- )  dispose of picture heap
  55.     :M  KILL:  get: picHndl  call KillPicture clear: picHndl  ;M
  56.  
  57. ;CLASS
  58.  
  59.  
  60.